home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / pointers.swg / 0042_Standard Array Object using EFLIB.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-11-29  |  9.8 KB  |  239 lines
  1.  
  2. { Borland Pascal Extended Function Library - EFLIB (C) Johan Larsson, 1996
  3.   Demonstration; sample unit with ADT implementation of the standard array
  4.  
  5.   This is an abstract data type engine for the Borland Pascal array list.
  6.   The program requires EFLIB to compile. EFLIB is a FREE and POWERFUL
  7.   object-oriented toolkit for Borland Pascal, to compile. It's available
  8.   via Internet at http://www.ts.umu.se/~jola/EFLIB/. EFLIB features not
  9.   only data structures, but also streams, user interface, and much more.
  10.  
  11.   If you have any question, write an e-mail to Johan Larsson at
  12.   jola@ts.umu.se.
  13.  
  14.   THIS SOURCE CODE IS DONATED TO PUBLIC DOMAIN FOR DISTRIBUTION WITH THE
  15.   SWAG PACKAGE. FEEL FREE TOO USE THE SOURCE CODE TO MAKE YOUR OWN,
  16.   ADVANCED EFLIB COMPATIBLE DATA STRUCTURE. }
  17.  
  18.  
  19. unit STDARRAY;
  20.  
  21.  
  22. INTERFACE
  23.  
  24. uses EFLIBDEF, EFLIBDAT;
  25.  
  26. const NumberOfElements = 1000;
  27.  
  28. type { Type of elements inside standard array object }
  29.      ElementType                       = real;
  30.  
  31.      { Implementation of a standard Pascal array with a compile-time fixed
  32.        size. Because this object is inherited from EFLIBs parent object for
  33.        data types, it has features such as sorting, searching and stream
  34.        storage (inherited methods). }
  35.      StandardArrayObjectPointerTyp     = ^StandardArrayObjectType;
  36.      StandardArrayObjectType           = object (DataObjectType)
  37.                                              public
  38.                                                { Fields }
  39.                                                BaseArray        : array [1 .. NumberOfElements] of ElementType;
  40.                                                LastUsed         : word;
  41.                                                { Miscellaneous methods }
  42.                                                procedure Clear; virtual;                           { Clears all elements }
  43.                                                { Methods for handling of elements }
  44.                                                procedure Add (var Data); virtual;                  { Adds an element }
  45.                                                procedure Insert (var Data; Index : word); virtual; { Inserts an element }
  46.                                                procedure Update (Index : word; var Data); virtual; { Updates an element }
  47.                                                procedure Element (Index : word; var Data);
  48.                                                          virtual;                                  { Retrieves an element }
  49.                                                procedure Erase (Index : word); virtual;            { Erases an element }
  50.                                                function Compare (Index1, Index2 : word) :
  51.                                                         shortint; virtual;                         { Compares two elements }
  52.                                                function CompareContent (Index : word; var Data) :
  53.                                                         shortint; virtual;                         { Compares element content }
  54.                                                { Methods for stream storage }
  55.                                                constructor StreamLoad (Stream : pointer);          { Loads from a stream }
  56.                                                { Methods for direct element access }
  57.                                                function ElementSize (Index : word) :
  58.                                                         word; virtual;                             { Size of element data }
  59.                                                function ElementPointer (Index : word) :
  60.                                                         pointer; virtual;                          { Returns element pointer }
  61.                                                { Status methods }
  62.                                                function Elements : word; virtual;                  { Number of elements }
  63.                                                function Capacity : word; virtual;                  { Capacity of elements }
  64.                                                function NameOfType : string; virtual;              { Name of object type }
  65.                                          end;
  66.  
  67.  
  68. IMPLEMENTATION
  69.  
  70. {$B-} {$IFNDEF DEBUG} {$I-} {$S-} {$R-} {$Q-} {$ENDIF}
  71.  
  72.  
  73. uses EFLIBIO;
  74.  
  75. { *** StandardArrayObjectType *** }
  76.  
  77. { Clears data type (ie. erases all elements). }
  78. procedure StandardArrayObjectType.Clear;
  79. begin
  80.      FillChar (BaseArray, SizeOf(BaseArray), 0);
  81.      LastUsed := 0;
  82. end;
  83.  
  84. { Adds data into data type in a new element. }
  85. procedure StandardArrayObjectType.Add (var Data);
  86. begin
  87.      if LastUsed < Capacity then begin
  88.         Inc (LastUsed); BaseArray[LastUsed] := ElementType(Data);
  89.      end else { Error; array is full } ;
  90. end;
  91.  
  92. { Inserts data to data type in a new element that follows specified indexed
  93.   element in order. If index is zero, element is inserted first in the
  94.   data type. }
  95. procedure StandardArrayObjectType.Insert (var Data; Index : word);
  96. var Count : word;
  97. begin
  98.      if Capacity > Elements then begin
  99.         { Pull elements inside array to make space for a new element }
  100.         for Count := Elements downto Succ(Index) do
  101.             BaseArray[Succ(Count)] := BaseArray[Count];
  102.         Inc (LastUsed); BaseArray[Index] := ElementType (Data);
  103.      end else { Error; array is full } ;
  104. end;
  105.  
  106. { Updates an element in the data type. }
  107. procedure StandardArrayObjectType.Update (Index : word; var Data);
  108. begin
  109.      if (Index >= 1) and (Index <= Elements) then
  110.         BaseArray[Index] := ElementType(Data)
  111.      else { Error; range check error; not a valid element index } ;
  112. end;
  113.  
  114. { Returns the data in an indexed element in the data type. }
  115. procedure StandardArrayObjectType.Element (Index : word; var Data);
  116. begin
  117.      if IsValid (Index) then
  118.         Move (BaseArray[Index], Data, ElementSize(Index))
  119.      else { Error; range check error; not a valid element index } ;
  120. end;
  121.  
  122. { Erases an element from the data type. This is a method that must be
  123.   overridden by all descendants. }
  124. procedure StandardArrayObjectType.Erase (Index : word);
  125. var Count : word;
  126. begin
  127.      if IsValid(Index) then begin
  128.         { Pull elements inside array to make space for a new element }
  129.         for Count := Index to Pred(Elements) do
  130.             BaseArray[Count] := BaseArray[Succ(Count)];
  131.         Dec (LastUsed);
  132.      end else { Error; range check error; not a valid element index } ;
  133. end;
  134.  
  135. { Compares two indexed elements inside the data type and returns
  136.   1, 0 or -1, depending on if the first element is bigger, equal
  137.   or smaller than the second element. }
  138. function StandardArrayObjectType.Compare (Index1, Index2 : word) : shortint;
  139. begin
  140.      if BaseArray[Index1] > BaseArray[Index2] then Compare := 1
  141.         else if BaseArray[Index1] < BaseArray[Index2] then Compare := -1
  142.              else Compare := 0;
  143. end;
  144.  
  145. { Compares the content of an elements with some data and returns
  146.   1, 0 or -1, depending on if the element is bigger, equal or smaller
  147.   than the data. }
  148. function StandardArrayObjectType.CompareContent (Index : word; var Data) : shortint;
  149. begin
  150.      if BaseArray[Index] > ElementType(Data) then CompareContent := 1
  151.         else if BaseArray[Index] < ElementType(Data) then CompareContent := -1
  152.              else CompareContent := 0;
  153. end;
  154.  
  155.  
  156. { Constructs and loads the object from a stream. This is an abstract
  157.   constructor that must be overridden by all descendants that support
  158.   stream storage. }
  159. constructor StandardArrayObjectType.StreamLoad (Stream : pointer);
  160. var Storage : StreamObjectPointerType absolute Stream;
  161. begin
  162.      if Storage^.IsInitialized and Storage^.IsAllocated and
  163.         not Storage^.IsWriteOnly then with Storage^ do begin
  164.  
  165.         { Load object data }
  166.         if Initialize then Inherited StreamLoad (Storage);
  167.  
  168.      end else { Error; failed to load object } ;
  169. end;
  170.  
  171.  
  172. { Returns the size of elements inside the data type. }
  173. function StandardArrayObjectType.ElementSize (Index : word) : word;
  174. begin ElementSize := SizeOf(ElementType); end;
  175.  
  176. { Returns a pointer to a specified elements data region. }
  177. function StandardArrayObjectType.ElementPointer (Index : word) : pointer;
  178. begin ElementPointer := @BaseArray[Index]; end;
  179.  
  180.  
  181. { Returns the number of elements inside the data type. }
  182. function StandardArrayObjectType.Elements : word;
  183. begin Elements := LastUsed; end;
  184.  
  185. { Returns the number of elements that can be stored inside the data
  186.   type. }
  187. function StandardArrayObjectType.Capacity : word;
  188. begin Capacity := SizeOf(BaseArray) div ElementSize (0); end;
  189.  
  190.  
  191. { Returns the full Borland Pascal name of the object type }
  192. function StandardArrayObjectType.NameOfType : string;
  193. begin NameOfType := 'StandardArrayObjectType'; end;
  194.  
  195.  
  196. end. { unit }
  197.  
  198.  
  199.  
  200. { - - - - - - - - - - - Cut here - - - - - - - - - }
  201.  
  202.  
  203. { Borland Pascal Extended Function Library - EFLIB (C) Johan Larsson, 1996
  204.   Demonstration; example on ARRAYLST.PAS implementation
  205.  
  206.   EFLIB IS PROTECTED BY THE COPYRIGHT LAW AND MAY NOT BE COPIED, SOLD OR
  207.   MANIPULATED. FOR MORE INFORMATION, SEE PROGRAM MANUAL! THIS DEMONSTRAT-
  208.   ION PROGRAM MAY FREELY BE USED AND DISTRIBUTED.                          }
  209.  
  210.  
  211. uses EFLIBDEF, STDARRAY;
  212.  
  213. var MyArray : StandardArrayObjectType; Number : real;
  214.  
  215. begin
  216.      WriteLn ('* Standard Pascal array implemented as a polymorphic EFLIB data type *');
  217.  
  218.      with MyArray do begin
  219.           Initialize;
  220.  
  221.           { Add some elements }
  222.           Number := 1.1; Add (Number);
  223.           Number := 2.2; Add (Number);
  224.           Number := 4.4; Add (Number);
  225.  
  226.           with CreateIterator^ do begin
  227.                repeat
  228.                      WriteLn (Real(Content^):0:2);
  229.                      WalkForward;
  230.                until IsEnd;
  231.                Free;
  232.           end;
  233.  
  234.           Intercept;
  235.      end;
  236. end.
  237.  
  238.  
  239.